home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / NAMSRC.f < prev    next >
Text File  |  1992-07-31  |  1KB  |  38 lines
  1.       SUBROUTINE NAMSRC(SNAME,SLIST,NLIST,IPOS,LAST)
  2. *-----------------------------------------------------------------------
  3. *   
  4. *   finds name in alphabetic table (binary search). 
  5. *   
  6. *   Input   
  7. *   SNAME           name to be looked up
  8. *   SLIST           table   
  9. *   NLIST           length of table 
  10. *   
  11. *   Output  
  12. *   IPOS            = 0: name not in table  
  13. *                   > 0: position in table  
  14. *   LAST            for IPOS=0, position behind which name belongs  
  15. *   
  16. *-----------------------------------------------------------------------
  17.       CHARACTER *(*) SNAME,SLIST(*) 
  18.       IPOS=0
  19.       LAST=0
  20.       N=NLIST   
  21.       IF(N.GT.0)  THEN  
  22.          KPOS=0 
  23.    10    M=(N+1)/2  
  24.          LAST=KPOS+M
  25.          IF (SNAME.LT.SLIST(LAST))  THEN
  26.             N=M 
  27.             LAST=LAST-1 
  28.             IF (N.GT.1) GOTO 10 
  29.          ELSEIF (SNAME.GT.SLIST(LAST))  THEN
  30.             KPOS=LAST   
  31.             N=N-M   
  32.             IF (N.GT.0) GOTO 10 
  33.          ELSE   
  34.             IPOS=LAST   
  35.          ENDIF  
  36.       ENDIF 
  37.       END   
  38.